home *** CD-ROM | disk | FTP | other *** search
/ Aminet 8 / Aminet 8 (1995)(GTI - Schatztruhe)[!][Oct 1995].iso / Aminet / comm / mail / MakeMail05b.lha / MakeMail / MakeMail.rexx < prev   
OS/2 REXX Batch file  |  1995-07-09  |  28KB  |  989 lines
  1. /***************************************************************************/
  2. /*                              MakeMail.rexx                              */
  3. /* ======================================================================= */
  4. /*                written 1995 by Ali Rene Schams-Pirzadeh                 */
  5. /* ======================================================================= */
  6. /*              GhostWriter for fido and compatible networks               */
  7. /* ======================================================================= */
  8. /* History:                                                                */
  9. /*                                                                         */
  10. /* v0.5beta :                                                  (June 1995) */
  11. /*  - number of mails in inbound-dir changed back to 100 again.            */
  12. /*  - changed the flags (PV,FL,CM,KS)                                      */
  13. /*  - works without flags now                                              */
  14. /*  - may use a configfile                                                 */
  15. /*  - added tmpfile-support                                                */
  16. /*  - translated doc-file(s) into german                                   */
  17. /*  - changed msgid (no ".0" will be added any more)                       */
  18. /*  - added keyword taskpri to cfg-file                                    */
  19. /*  - added keyword stack to cfg-file                                      */
  20. /*  - added 5-dim-addressing                                               */
  21. /*                                                                         */
  22. /* v0.4beta :                                                  (June 1995) */
  23. /*  - if words(toname)=2 the subject has been crypted. fixed               */
  24. /*  - checks all parameter-keywords now                                    */
  25. /*  - works with more than 99 mails in inbound-dir now                     */
  26. /*  - Thomas Strauss (AmiNet-Upload) got a copy of it                      */
  27. /*                                                                         */
  28. /* v0.3beta :                                                   (May 1995) */
  29. /*  - added node-support (works with .0 now !)                             */
  30. /*                                                                         */
  31. /* v0.2beta :                                                 (April 1995) */
  32. /*  - changed the output a little bit                                      */
  33. /*  - optimized the source                                                 */
  34. /*                                                                         */
  35. /* v0.1beta :                                                 (March 1995) */
  36. /*  - the first try ;-))                                                   */
  37. /* ======================================================================= */
  38. /* Examples:                                                               */
  39. /*                                                                         */
  40. /* rx MakeMail.rexx                                                        */
  41. /*    AREA     "matrix"                                                    */
  42. /*    FROMADR  2:2464/221.0                                                */
  43. /*    FROM     "Ali Rene Schams-Pirzadeh"                                  */
  44. /*    TOADR    2:2464/220.0                                                */
  45. /*    TO       "Ali Rene Schams-Pirzadeh"                                  */
  46. /*    FLAGS    "CM"                                                        */
  47. /*    SUBJECT  "This is an example"                                        */
  48. /*    FILE     "MakeMail.rexx"                                             */
  49. /*    INBOUND  "inbound:"                                                  */
  50. /*    ORIGIN   "Original-<-Origin->-"                                      */
  51. /*                                                                         */
  52. /* rx MakeMail.rexx                                                        */
  53. /*    AREA     "netmail"                                                   */
  54. /*    FROMADR  2:2464/221.0                                                */
  55. /*    FROM     "Ali Rene Schams-Pirzadeh"                                  */
  56. /*    TOADR    2:2464/220.0                                                */
  57. /*    TO       "Ali Rene Schams-Pirzadeh"                                  */
  58. /*    FLAGS    "CM"                                                        */
  59. /*    SUBJECT  "This is an example"                                        */
  60. /*    FILE     "MakeMail.rexx"                                             */
  61. /*    INBOUND  "inbound:"                                                  */
  62. /*    ORIGIN   "Original-<-Origin->-"                                      */
  63. /*                                                                         */
  64. /* rx MakeMail.rexx                                                        */
  65. /*    AREA     "newfiles.ger"                                              */
  66. /*    FROMADR  2:2464/221.0                                                */
  67. /*    FROM     "Ali Rene Schams-Pirzadeh"                                  */
  68. /*    TO       "Ali Rene Schams-Pirzadeh"                                  */
  69. /*    FLAGS    "CM"                                                        */
  70. /*    SUBJECT  "This is an example"                                        */
  71. /*    FILE     "MakeMail.rexx"                                             */
  72. /*    INBOUND  "inbound:"                                                  */
  73. /*    ORIGIN   "Original-<-Origin->-"                                      */
  74. /***************************************************************************/
  75. /* needs external:                                                         */
  76. /*  - 'rexxsupport.library'                                                */
  77. /*  - 'c:delete'                                                           */
  78. /***************************************************************************/
  79.  
  80.  
  81.  
  82. cr          = "0d"x;
  83. flags       = "";
  84. areaname    = "";
  85. fromadr     = "";
  86. fromname    = "";
  87. toadr       = "";
  88. toadrdummy  = "";
  89. toname      = "";
  90. subject     = "";
  91. file        = "";
  92. inbound     = "";
  93. origin      = "";
  94. pvtmail     = 0;
  95. null        = "00"x
  96.  
  97. maxmail     = 100; /* the maximum number of files to create */
  98. version     = "MakeMail v0.5beta"
  99. mydelete    = "C:Delete"
  100. tmpfile1    = "RAM:MakeMail.tmp"
  101. pri         = -8;
  102. stacksize   = 300000;
  103.  
  104.  
  105.  
  106. parse arg areanamedummy dummy
  107.  
  108. call showheader;
  109.  
  110.  
  111.  
  112. if upper(areanamedummy)=upper("CONFIG") then do;
  113.  cfgfilename=reverse(trim(reverse(trim(dummy))));
  114.  
  115.  if substr(cfgfilename,1,1)='"' then cfgfilename=substr(cfgfilename,2,length(cfgfilename)-1);
  116.  if length(cfgfilename)=0 then signal wrongparm;
  117.  if substr(cfgfilename,length(cfgfilename),1)='"' then cfgfilename=substr(cfgfilename,1,length(cfgfilename)-1);
  118.  
  119.  call getcfgfile;
  120. end;
  121. else do;
  122.  if upper(areanamedummy)=upper("AREA") then do;
  123.   call getparm;
  124.  end;
  125.  else do;
  126.   say "*** Cannot find keyword AREA or CONFIG !"
  127.  
  128.   signal rauserror;
  129.  end;
  130. end;
  131.  
  132.  
  133.  
  134. inbound=upper(inbound);
  135.  
  136. fromadr=reverse(trim(reverse(trim(fromadr))));
  137. if length(fromadr)=0 then signal wrongparm;
  138. if substr(fromadr,1,1)='"' then fromadr=substr(fromadr,2,length(fromadr)-1);
  139. if substr(fromadr,length(fromadr),1)='"'  then fromadr=substr(fromadr,1,length(fromadr)-1);
  140. if pos(".",fromadr)=0 then fromadr=fromadr".0"
  141.  
  142. fromname=reverse(trim(reverse(trim(fromname))));
  143. if length(fromname)=0 then signal wrongparm;
  144. if substr(fromname,1,1)='"' then fromname=substr(fromname,2,length(fromname)-1);
  145. if substr(fromname,length(fromname),1)='"'  then fromname=substr(fromname,1,length(fromname)-1);
  146.  
  147. if pvtmail="1" then do;
  148.  toadr=reverse(trim(reverse(trim(toadr))));
  149.  if length(toadr)=0 then signal wrongparm;
  150.  if substr(toadr  ,1,1)='"' then toadr  =substr(toadr,2,length(toadr)-1);
  151.  if substr(toadr  ,length(toadr),1)='"'    then toadr  =substr(toadr,1,length(toadr)-1);
  152.  if pos(".",toadr)=0 then toadr=toadr".0"
  153. end;
  154.  
  155. toname=reverse(trim(reverse(trim(toname))));
  156. if length(toname)=0 then signal wrongparm;
  157. if substr(toname  ,1,1)='"' then toname  =substr(toname,2,length(toname)-1);
  158. if substr(toname  ,length(toname),1)='"'    then toname  =substr(toname,1,length(toname)-1);
  159.  
  160. flags=reverse(trim(reverse(trim(flags))));
  161. if length(flags)>0 then do;
  162.  if substr(flags  ,1,1)='"' then flags  =substr(flags,2,length(flags)-1);
  163.  if substr(flags  ,length(flags),1)='"'    then flags  =substr(flags,1,length(flags)-1);
  164. end;
  165.  
  166. subject=reverse(trim(reverse(trim(subject))));
  167. if length(subject)=0 then signal wrongparm;
  168. if substr(subject ,1,1)='"' then subject =substr(subject,2,length(subject)-1);
  169. if substr(subject ,length(subject),1)='"' then subject=substr(subject,1,length(subject)-1);
  170.  
  171. file=reverse(trim(reverse(trim(file))));
  172. if length(file)=0 then signal wrongparm;
  173. if substr(file    ,1,1)='"' then file    =substr(file,2,length(file)-1);
  174. if substr(file    ,length(file),1)='"'    then file   =substr(file,1,length(file)-1);
  175.  
  176. inbound=reverse(trim(reverse(trim(inbound))));
  177. if length(inbound)=0 then signal wrongparm;
  178. if substr(inbound  ,1,1)='"' then inbound  =substr(inbound,2,length(inbound)-1);
  179. if substr(inbound  ,length(inbound),1)='"'  then inbound=substr(inbound,1,length(inbound)-1);
  180.  
  181. origin=reverse(trim(reverse(trim(origin))));
  182. if length(origin)=0 then signal wrongparm;
  183. if substr(origin,1,1)='"' then origin  =substr(origin,2,length(origin)-1);
  184. if substr(origin,length(origin),1)='"'  then origin=substr(origin,1,length(origin)-1);
  185.  
  186. if exists(file)=0 then do;
  187.  say "*** file '"file"' does not exist !"
  188.  signal rauserror;
  189. end;
  190.  
  191. say "    area: '"areaname"'"
  192. say " fromadr: "fromadr
  193. say "fromname: '"fromname"'"
  194.  
  195.  if pvtmail="1" then do;
  196.   say "   toadr: "toadr
  197.  end;
  198.  
  199. say "  toname: '"toname"'"
  200. say " subject: '"subject"'"
  201. say "    file: '"file"'"
  202. say " inbound: '"inbound"'"
  203. say "  origin: '"origin"'"
  204.  
  205. options results;
  206. options failat 200;
  207.  
  208. if pvtmail="1" then do;
  209.  if pos("@",toadr)=0 then toadr=toadr"@"
  210. end;
  211.  
  212. if pos("@",fromadr)=0 then fromadr=fromadr"@"
  213.  
  214. d1=pos(":",fromadr)
  215. if d1=0 then signal wrongparm;
  216. zonehere    =substr(fromadr,1,d1-1);
  217. fromadr     =substr(fromadr,d1+1,length(fromadr)-(d1+1)+1);
  218. d1=pos("/",fromadr);
  219. if d1=0 then signal wrongparm;
  220. nethere     =substr(fromadr,1,d1-1);
  221. fromadr     =substr(fromadr,d1+1,length(fromadr)-(d1+1)+1);
  222. d1=pos(".",fromadr);
  223. if d1=0 then signal wrongparm;
  224. nodehere    =substr(fromadr,1,d1-1);
  225. fromadr     =substr(fromadr,d1+1,length(fromadr)-(d1+1)+1);
  226. d1=pos("@",fromadr);
  227. if d1=0 then signal wrongparm;
  228. pointhere   =substr(fromadr,1,d1-1);
  229. netnamehere =substr(fromadr,d1+1,length(fromadr)-(d1+1)+1);
  230.  
  231. if pvtmail="0" then do;
  232.  zonenumber =zonehere;
  233.  netnumber  =nethere;
  234.  nodenumber =nodehere;
  235.  pointnumber=pointhere;
  236.  netname    =netnamehere;
  237. end;
  238. else do;
  239.  d1=pos(":",toadr)
  240.  if d1=0 then signal wrongparm;
  241.  zonenumber  =substr(toadr,1,d1-1);
  242.  toadr=substr(toadr,d1+1,length(toadr)-(d1+1)+1);
  243.  d1=pos("/",toadr);
  244.  if d1=0 then signal wrongparm;
  245.  netnumber   =substr(toadr,1,d1-1);
  246.  toadr=substr(toadr,d1+1,length(toadr)-(d1+1)+1);
  247.  d1=pos(".",toadr);
  248.  if d1=0 then signal wrongparm;
  249.  nodenumber  =substr(toadr,1,d1-1);
  250.  toadr       =substr(toadr,d1+1,length(toadr)-(d1+1)+1);
  251.  d1=pos("@",toadr);
  252.  if d1=0 then signal wrongparm;
  253.  pointnumber  =substr(toadr,1,d1-1);
  254.  netname      =substr(toadr,d1+1,length(toadr)-(d1+1)+1);
  255. end;
  256.  
  257. mydate       = date();
  258. mydatei      = date("I");
  259. mytime       = time();
  260. mytimes      = time("S");
  261.  
  262.  
  263.  
  264. if ~show("L","rexxsupport.library") then
  265.  call addlib("rexxsupport.library",0,-30);
  266.  
  267.  
  268.  
  269. pragma("stack",stacksize);
  270. pragma("priority",pri);
  271.  
  272.  
  273.  
  274. call prepmail;
  275.  
  276. reportfilename=inbound"00000"
  277.  
  278. o=1
  279. marker=0;
  280. do while marker=0
  281.  o2=maxmail-o;
  282.  if o2<100 then o2="0"o2
  283.  if o2<10 then o2="0"o2
  284.  if exists(reportfilename||o2".pkt")=1 then marker=1;
  285.  else do;
  286.   if o=maxmail then marker=2
  287.  end;
  288.  o=o+1;
  289. end;
  290.  
  291. if marker=1 then do;
  292.  o2=o2+1;
  293. end;
  294.  
  295. if marker=2 then do;
  296.  o2=0;
  297. end;
  298.  
  299. if o2<100 then o2="0"o2;
  300. if o2<10 then o2="0"o2;
  301. reportfilename=reportfilename||o2".pkt"
  302.  
  303. call open(report,reportfilename,"W");
  304. writech(report,msginfo);
  305.  
  306. if exists(file)=0 then do;
  307.  signal wrongparm;
  308. end;
  309.  
  310. call open(mail,file,"R");
  311.  
  312. do while eof(mail)=0
  313.  zeile=readln(mail);
  314.  if eof(mail)=0 then do;
  315.   writeln(report,zeile||cr);
  316.  end;
  317. end;
  318.  
  319. call close(mail);
  320.  
  321. if pvtmail="0" then do;
  322.  writeln(report,"---"cr);
  323.  writech(report," * Origin: "origin" ("zonehere":"nethere"/"nodehere"."pointhere);
  324.  if netnamehere~="" then writech(report,"@"netnamehere);
  325.  writech(report,")"cr);
  326.  writech(report,"SEEN-BY: "nethere"/"nodehere);
  327.  if netnamehere~="" then writech(report,"@"netnamehere);
  328.  writech(report,")"cr);
  329.  writech(report,"01"x||"PATH: "nethere"/"nodehere);
  330.  if netnamehere~="" then writech(report,"@"netnamehere);
  331.  writech(report,")"cr);
  332. end;
  333.  
  334. writech(report,null||null||null);
  335. call close(report);
  336.  
  337.  
  338.  
  339.  
  340.  
  341. raushier:;
  342.  
  343. /*
  344.  ============================================================================
  345.  close all files if open and quit this frequest handler
  346.  ============================================================================
  347. */
  348.  
  349.  if reportopen=1 then do;
  350.   call close(report);
  351.  end;
  352.  
  353.  call deletetmpfile;
  354.  
  355. exit;
  356.  
  357.  
  358.  
  359.  
  360.  
  361. rauserror:;
  362.  
  363. /*
  364.  ============================================================================
  365.  exit with errorcode 100
  366.  ============================================================================
  367. */
  368.  
  369.  call deletetmpfile;
  370.  
  371. exit 100;
  372.  
  373.  
  374.  
  375.  
  376.  
  377. getparm:;
  378.  
  379. /*
  380.  ============================================================================
  381.  parse all parameters
  382.  ============================================================================
  383. */
  384.  
  385.  parse var dummy areaname fromadrdummy fromadr fromnamedummy zz dummy
  386.  
  387.  
  388.  
  389.  areaname=upper(areaname);
  390.  if length(areanamedummy)=0 then signal informparm;
  391.  
  392.  if substr(areaname,1,1)='"' then areaname=substr(areaname,2,length(areaname)-1);
  393.  if substr(areaname,length(areaname),1)='"'  then areaname=substr(areaname,1,length(areaname)-1);
  394.  
  395.  if upper(fromadrdummy)~=upper("FROMADR") then do;
  396.   say "*** Cannot find keyword FROMADR !"
  397.   signal rauserror;
  398.  end;
  399.  
  400.  if upper(fromnamedummy)~=upper("FROM") then do;
  401.   say "*** Cannot find keyword FROM !"
  402.   signal rauserror;
  403.  end;
  404.  
  405.  
  406.  
  407.  z="";
  408.  
  409.  do while substr(zz,length(zz),1)~='"'
  410.   if length(z)=0
  411.   then z=zz
  412.   else z=z" "zz
  413.   parse var dummy zz dummy
  414.  end;
  415.  if length(z)=0
  416.   then z=zz
  417.   else z=z" "zz
  418.  
  419. /* fromname=substr(z,2,length(z)-2); */
  420. fromname=z;
  421.  
  422.  
  423.  
  424.  if areaname=upper("matrix")|areaname=upper("netmail") then do
  425.   parse var dummy toadrdummy toadr dummy
  426.   pvtmail = 1
  427.  end;
  428.  
  429.  
  430.  
  431.  parse var dummy tonamedummy zz dummy
  432.  
  433.  if upper(tonamedummy)~=upper("TO") then do;
  434.   say "*** Cannot find keyword TO !"
  435.   signal rauserror;
  436.  end;
  437.  
  438.  
  439.  
  440.  z="";
  441.  
  442.  do while substr(zz,length(zz),1)~='"'
  443.   if length(z)=0
  444.   then z=zz
  445.   else z=z" "zz
  446.   parse var dummy zz dummy
  447.  end;
  448.  if length(z)=0
  449.   then z=zz
  450.   else z=z" "zz
  451.  
  452. /* toname=substr(z,2,length(z)-2); */
  453. toname=z;
  454.  
  455.  
  456.  
  457.  parse var dummy flagsdummy zz dummy
  458.  
  459.  if upper(flagsdummy)~=upper("FLAGS") then do;
  460.   say "*** Cannot find keyword FLAGS !"
  461.   signal rauserror;
  462.  end;
  463.  
  464.  
  465.  
  466.  z=flags;
  467.  
  468.  do while substr(zz,length(zz),1)~='"'
  469.   if length(z)=0
  470.   then z=zz
  471.   else z=z" "zz
  472.   parse var dummy zz dummy
  473.  end;
  474.  if length(z)=0
  475.   then z=zz
  476.   else z=z" "zz
  477.  
  478. /* flags=substr(z,2,length(z)-2); */
  479. flags=z;
  480.  
  481.  
  482.  
  483.  parse var dummy subjectdummy zz dummy
  484.  
  485.  if upper(subjectdummy)~=upper("SUBJECT") then do;
  486.   say "*** Cannot find keyword SUBJECT !"
  487.   signal rauserror;
  488.  end;
  489.  
  490.  
  491.  
  492.  z="";
  493.  
  494.  do while substr(zz,length(zz),1)~='"'
  495.   if length(z)=0
  496.   then z=zz
  497.   else z=z" "zz
  498.   parse var dummy zz dummy
  499.  end;
  500.  if length(z)=0
  501.   then z=zz
  502.   else z=z" "zz
  503.  
  504. /* subject=substr(z,2,length(z)-2); */
  505. subject=z;
  506.  
  507.  
  508.  
  509.  parse var dummy filedummy zz dummy
  510.  
  511.  
  512.  
  513.  z="";
  514.  
  515.  do while substr(zz,length(zz),1)~='"'
  516.   if length(z)=0
  517.   then z=zz
  518.   else z=z" "zz
  519.   parse var dummy zz dummy
  520.  end;
  521.  if length(z)=0
  522.   then z=zz
  523.   else z=z" "zz
  524.  
  525. /* file=substr(z,2,length(z)-2); */
  526. file=z;
  527.  
  528.  
  529.  
  530.  parse var dummy inbounddummy inbound origindummy origin
  531.  
  532.  if upper(inbounddummy)~=upper("INBOUND") then do;
  533.   say "*** Cannot find keyword INBOUND !"
  534.   signal rauserror;
  535.  end;
  536.  
  537.  if upper(origindummy)~=upper("ORIGIN") then do;
  538.   say "*** Cannot find keyword ORIGIN !"
  539.   signal rauserror;
  540.  end;
  541.  
  542. return;
  543.  
  544.  
  545.  
  546.  
  547.  
  548. getcfgfile:;
  549.  
  550. /*
  551.  ============================================================================
  552.  read the config-file
  553.  ============================================================================
  554. */
  555.  
  556. if exists(cfgfilename)=1 then do;
  557.  call open(tmp,cfgfilename,"R");
  558.   do while eof(tmp)=0
  559.    zeile=readln(tmp);
  560.    if length(zeile)>0 then do;
  561.     if substr(zeile,1,1)~==";" then do;
  562.      if upper(word(zeile,1))==upper("area") then do;
  563.       areaname=upper(substr(zeile,6,length(zeile)-6+1));
  564.  
  565.       areaname=reverse(trim(reverse(trim(areaname))));
  566.       if substr(areaname,1,1)='"' then areaname=substr(areaname,2,length(areaname)-1);
  567.       if substr(areaname,length(areaname),1)='"' then areaname=substr(areaname,1,length(areaname)-1);
  568.      end;
  569.  
  570.      if upper(word(zeile,1))==upper("taskpri") then do;
  571.       pri=word(zeile,2);
  572.      end;
  573.  
  574.      if upper(word(zeile,1))==upper("stack") then do;
  575.       stacksize=word(zeile,2);
  576.      end;
  577.  
  578.      if upper(word(zeile,1))==upper("fromadr") then do;
  579.       fromadr=substr(zeile,9,length(zeile)-9+1);
  580.      end;
  581.  
  582.      if upper(word(zeile,1))==upper("from") then do;
  583.       fromname=substr(zeile,6,length(zeile)-6+1);
  584.      end;
  585.  
  586.      if upper(word(zeile,1))==upper("toadr") then do;
  587.       toadr=substr(zeile,7,length(zeile)-7+1);
  588.      end;
  589.  
  590.      if upper(word(zeile,1))==upper("to") then do;
  591.       toname=substr(zeile,4,length(zeile)-4+1);
  592.      end;
  593.  
  594.      if upper(word(zeile,1))==upper("subject") then do;
  595.       subject=substr(zeile,9,length(zeile)-9+1);
  596.      end;
  597.  
  598.      if upper(word(zeile,1))==upper("flags") then do;
  599.       flags=substr(zeile,7,length(zeile)-7+1);
  600.      end;
  601.  
  602.      if upper(word(zeile,1))==upper("file") then do;
  603.       file=substr(zeile,6,length(zeile)-6+1);
  604.      end;
  605.  
  606.      if upper(word(zeile,1))==upper("inbound") then do;
  607.       inbound=substr(zeile,9,length(zeile)-9+1);
  608.      end;
  609.  
  610.      if upper(word(zeile,1))==upper("origin") then do;
  611.       origin=substr(zeile,8,length(zeile)-8+1);
  612.  
  613.       origin=reverse(trim(reverse(trim(origin))));
  614.       if substr(origin,1,1)='"' then origin=substr(origin,2,length(origin)-1);
  615.       if substr(origin,length(origin),1)='"' then origin=substr(origin,1,length(origin)-1);
  616.      end;
  617.  
  618.     end;
  619.    end;
  620.   end;
  621.  call close(tmp);
  622.  
  623.  if areaname="" then do;
  624.   say "*** Cannot find keyword AREA !"
  625.   signal rauserror;
  626.  end;
  627.  
  628.  if fromadr="" then do;
  629.   say "*** Cannot find keyword FROMADR !"
  630.   signal rauserror;
  631.  end;
  632.  
  633.  if fromname="" then do;
  634.   say "*** Cannot find keyword FROMNAME !"
  635.   signal rauserror;
  636.  end;
  637.  
  638.  if areaname=upper("matrix")|areaname=upper("netmail") then do
  639.   pvtmail = 1
  640.  
  641.   if toadr="" then do;
  642.    say "*** Cannot find keyword TOADR !"
  643.    signal rauserror;
  644.   end;
  645.  end;
  646.  
  647.  if toname="" then do;
  648.   say "*** Cannot find keyword TONAME !"
  649.   signal rauserror;
  650.  end;
  651.  
  652.  if subject="" then do;
  653.   say "*** Cannot find keyword SUBJECT !"
  654.   signal rauserror;
  655.  end;
  656.  
  657.  if file="" then do;
  658.   say "*** Cannot find keyword FILE !"
  659.   signal rauserror;
  660.  end;
  661.  
  662.  if inbound="" then do;
  663.   say "*** Cannot find keyword INBOUND !"
  664.   signal rauserror;
  665.  end;
  666.  
  667.  if origin="" then do;
  668.   say "*** Cannot find keyword ORIGIN !"
  669.   signal rauserror;
  670.  end;
  671.  
  672. end;
  673. else do;
  674.  say "*** Fatal error occured - cannot open cfgfilename '"cfgfilename"' !"
  675.  
  676.  signal rauserror;
  677. end;
  678.  
  679. return;
  680.  
  681.  
  682.  
  683.  
  684.  
  685. changedate:;
  686.  
  687. /*
  688.  ============================================================================
  689.  change alphanumeric month into numeric one
  690.  ============================================================================
  691. */
  692.  
  693.  ii=pos(upper(filedate),upper("JanFebMarAprMayJunJulAugSepOctNovDec"));
  694.  filedate=(ii+2)/3
  695.  
  696. return;
  697.  
  698.  
  699.  
  700.  
  701.  
  702. changemonth:;
  703.  
  704. /*
  705.  ============================================================================
  706.  change numeric month into alphanumeric one
  707.  ============================================================================
  708. */
  709.  
  710.  
  711.  ii=pos(upper(filedate),upper("010203040506070809101112"));
  712.  filedate=substr("JanFebMarAprMayJunJulAugSepOctNovDec",(3*((ii+1)/2))-2,3);
  713.  
  714. return;
  715.  
  716.  
  717.  
  718.  
  719.  
  720. prepmail:;
  721.  
  722. /*
  723.  ============================================================================
  724.  prep the netmail
  725.  ============================================================================
  726. */
  727.  
  728.  null72         = copies(null,72)
  729.  Pass           = left(null72,8)
  730.  Fill           = left(null72,14)
  731.  fill2          = left(null72,4);
  732.  
  733.  
  734.  
  735.  Parse Var mytime Hour":"Minute":"Second
  736.  
  737.  Year           = substr(mydate,length(mydate)-1,2)
  738.  Year           = substr('0000'||D2X(year),length("0000"||d2x(year))-3,4)
  739.  YearHi         = X2C(substr(year,             1,2))
  740.  YearLo         = X2C(substr(year,length(year)-1,2))
  741.  
  742.  Month          = Substr(mydate,4,3)
  743.  Month          = Pos(Month,"JanFebMarAprMayJunJulAugSepOctNovDec")
  744.  Month          = X2C(Right("00"||(((Month+2)/3)-1),2))||null
  745.  
  746.  Day            = Left(mydate,2)
  747.  Day            = Right('0000'||D2X(Day),4)
  748.  DayHi          = X2C(Left(Day,2))
  749.  DayLo          = X2C(Right(Day,2))
  750.  
  751.  Today          = left(mydate,7)||right(mydate,2)||"  "mytime||null
  752.  
  753.  Hour           = right('0000'||D2X(Hour),4)
  754.  HourHi         = X2C(left(Hour,2))
  755.  HourLo         = X2C(right(Hour,2))
  756.  
  757.  Minute         = right('0000'||D2X(Minute),4)
  758.  MinuteHi       = X2C(left(Minute,2))
  759.  MinuteLo       = X2C(right(Minute,2))
  760.  
  761.  Second         = right('0000'||D2X(Second),4)
  762.  SecondHi       = X2C(left(Day,2))
  763.  SecondLo       = X2C(right(Second,2))
  764.  
  765.  Baud           = null||null
  766.  TRead          = null||null
  767.  Cost           = null||null
  768.  
  769.  Dzonenumber    = right('0000'||D2X(zonenumber),4)
  770.  DzonenumberHi  = X2C(left(Dzonenumber,2))
  771.  DzonenumberLo  = X2C(right(Dzonenumber,2))
  772.  
  773.  Dnodenumber    = right('0000'||D2X(nodenumber),4)
  774.  DnodenumberHi  = X2C(left(Dnodenumber,2))
  775.  DnodenumberLo  = X2C(right(Dnodenumber,2))
  776.  
  777.  Dnetnumber     = right('0000'||D2X(netnumber),4)
  778.  DnetnumberHi   = X2C(left(Dnetnumber,2))
  779.  DnetnumberLo   = X2C(right(Dnetnumber,2))
  780.  
  781.  Dpointnumber   = right('0000'||D2X(pointnumber),4)
  782.  DpointnumberHi = X2C(left(Dpointnumber,2))
  783.  DpointnumberLo = X2C(right(Dpointnumber,2))
  784.  
  785.  Ozonenumber    = right('0000'||D2X(zonehere),4)
  786.  OzonenumberHi  = X2C(left(Ozonenumber,2))
  787.  OzonenumberLo  = X2C(right(Ozonenumber,2))
  788.  
  789.  Onodenumber    = right('0000'||D2X(nodehere),4)
  790.  OnodenumberHi  = X2C(left(Onodenumber,2))
  791.  OnodenumberLo  = X2C(right(Onodenumber,2))
  792.  
  793.  Onetnumber     = right('0000'||D2X(nethere),4)
  794.  OnetnumberHi   = X2C(left(Onetnumber,2))
  795.  OnetnumberLo   = X2C(right(Onetnumber,2))
  796.  
  797.  Opointnumber   = right('0000'||D2X(pointhere),4)
  798.  OpointnumberHi = X2C(left(Opointnumber,2))
  799.  OpointnumberLo = X2C(right(Opointnumber,2))
  800.  
  801.  DAddr          = Dnetnumber||Dnodenumber
  802.  Prod           = '00'x
  803.  Serial         = '00'x
  804.  ReplyTo        = null||null
  805.  
  806. /* attrib: pvt         [pv] = "01"x = "  1"d */
  807. /*         crashmail   [cm] = "02"x = "  2"d */
  808. /*         not used         = "04"x = "  4"d */
  809. /*         not used         = "08"x = "  8"d */
  810. /*         file attach [fl] = "10"x = " 16"d */
  811. /*         not used         = "20"x = " 32"d */
  812. /*         not used         = "40"x = " 64"d */
  813. /*         kill/send   [ks] = "80"x = "128"d */
  814.  
  815.  attrib=0;
  816.  do i=1 to words(flags)
  817.  
  818.   thisflag=upper(word(flags,i));
  819.   thisflag=reverse(trim(reverse(trim(thisflag))));
  820.   if substr(thisflag,1,1)='"' then thisflag=substr(thisflag,2,length(thisflag)-1);
  821.   if substr(thisflag,length(thisflag),1)='"' then thisflag=substr(thisflag,1,length(thisflag)-1);
  822.  
  823.   if thisflag=upper("pv") then attrib=attrib+  1;
  824.   if thisflag=upper("cm") then attrib=attrib+  2;
  825.   if thisflag=upper("fl") then attrib=attrib+ 16; /* "10"x */
  826.   if thisflag=upper("ks") then attrib=attrib+128; /* "80"x */
  827.  end;
  828.  
  829.  if pvtmail="0" then do;
  830.   attrib = bitand(attrib,"FE"x); /* echomails are NEVER private ! */
  831.  end;
  832.  else do;
  833.   attrib = bitand(attrib,"FE"x); /* netmails are ALWAYS private ! */
  834.   attrib = attrib+1;             /* 'bitor' has a bug !           */
  835.  end;
  836.  
  837.  Attrib         = d2c(attrib)||d2c("00")
  838.  NReply         = null||null
  839.  PMsgStart      = '02'x||'00'x
  840.  
  841.  INTL           = '01'x||'INTL 'zonenumber':'netnumber'/'nodenumber
  842.  if pointnumber~="0" then intl=intl'.'pointnumber
  843.  if netname~="" then intl=intl"@"netname;
  844.  intl=intl' 'zonehere':'nethere'/'nodehere
  845.  if pointhere~="0" then intl=intl'.'pointhere
  846.  if netnamehere~="" then intl=intl"@"netnamehere
  847.  intl=intl||CR
  848.  
  849.  TOPT           = '01'x||'TOPT 'pointnumber||CR
  850.  
  851.  /************************************************/
  852.  /* Figure out Message-ID from 01/01/70 00:00:00 */
  853.  /* Code by: Bob English                         */
  854.  /************************************************/
  855.  
  856.                                    /* Find number of days since 1/1/78       */
  857.                                    /* Find number of secs since midnight     */
  858.  Secs70 = 252460600                    /* Number of secs from 1/1/70 to 12/31/77 */
  859.  ID  = (mydatei * 86400) + mytimes + Secs70  /* Add up all the seconds for the MsgID   */
  860.  
  861.  MID = D2X(ID)                         /* Convert to Hex */
  862.  
  863.  /************************************************/
  864.  
  865. msgid="";
  866.  
  867. if pvtmail="0" then do;
  868.  msgid=msgid"AREA:"areaname||cr
  869. end;
  870.  
  871.  
  872.  
  873.  MsgID = msgid||"01"x||"MSGID: "zonehere":"nethere"/"nodehere
  874.  if pointhere~="0" then msgid=msgid"."pointhere
  875.  if netnamehere~="" then msgid=msgid"@"netnamehere
  876.  msgid=msgid" "MID||CR
  877.  
  878.  PID = '01'x||'PID: 'version||CR
  879.  
  880. /* 20 */
  881.  PHead1 = OnodenumberLo||OnodenumberHi||DnodenumberLo||DnodenumberHi||YearLo||YearHi||Month||DayLo||DayHi||HourLo||HourHi||MinuteLo||MinuteHi||SecondLo||SecondHi||Baud||'02'x||'00'x
  882. /* 14 */
  883.  PHead2 = OnetnumberLo||OnetnumberHi||DnetnumberLo||DnetnumberHi||Prod||Serial||Pass||OzonenumberLo||OzonenumberHi||DzonenumberLo||DzonenumberHi
  884. /* 20 */
  885.  phead2=phead2||fill||dpointnumberlo||dpointnumberhi||fill2;
  886.  
  887.  MsgInfo = PMsgStart||OnodenumberLo||OnodenumberHi||DnodenumberLo||DnodenumberHi||OnetnumberLo||OnetnumberHi||DnetnumberLo||DnetnumberHi||Attrib||Cost||Today||toname||null||fromname||null||subject||null
  888.  if pvtmail="1" then do;
  889.   If Ozonenumber ~= Dzonenumber then MsgInfo = MsgInfo||INTL||MsgID||PID
  890.    Else MsgInfo = MsgInfo||MsgID||PID
  891.   If pointnumber ~= 0 then MsgInfo = MsgInfo||TOPT
  892.  end;
  893.  else do;
  894.   msginfo=msginfo||msgid||pid
  895.  end;
  896.  
  897.  
  898.  
  899. msginfo=phead1||phead2||msginfo;
  900.  
  901.  
  902.  
  903. return;
  904.  
  905.  
  906.  
  907.  
  908.  
  909. showheader:;
  910.  
  911. /*
  912.  ============================================================================
  913.  inform the user the number of parameters is wrong !
  914.  ============================================================================
  915. */
  916.  
  917.  say ""version" --- Copyright (c) 1995 by Ali Rene Schams-Pirzadeh, Germany"
  918.  say "Ghostwriter for fido and compatible networks. Read the docs for more info !!!"
  919. return;
  920.  
  921.  
  922.  
  923.  
  924.  
  925. informparm:;
  926.  
  927. /*
  928.  ============================================================================
  929.  inform the user the number of parameters is wrong !
  930.  ============================================================================
  931. */
  932.  
  933.  say "*** Fatal error occured !   --->   Wrong number of parameters !"
  934.  
  935. signal rauserror;
  936.  
  937.  
  938.  
  939.  
  940.  
  941. wrongparm:;
  942.  
  943. /*
  944.  ============================================================================
  945.  inform the user the number of parameters is wrong !
  946.  ============================================================================
  947. */
  948.  
  949.  say "*** Fatal error occured !"
  950.  
  951.  if length(areaname)>0 then say "    area: '"areaname"'"
  952.  if length(fromadr )>0 then say " fromadr: "fromadr
  953.  if length(fromname)>0 then say "fromname: '"fromname"'"
  954.  
  955.  if pvtmail="1" then do;
  956.   if length(toadr)>0 then say "   toadr: "toadr
  957.  end;
  958.  
  959.  if length(toname  )>0 then say "  toname: '"toname"'"
  960.  if length(subject )>0 then say " subject: '"subject"'"
  961.  if length(file    )>0 then say "    file: '"file"'"
  962.  if length(inbound )>0 then say " inbound: '"inbound"'"
  963.  if length(origin  )>0 then say "  origin: '"origin"'"
  964.  
  965. signal rauserror;
  966.  
  967.  
  968.  
  969.  
  970.  
  971. deletetmpfile:;
  972.  
  973. /*
  974.  ============================================================================
  975.  delete all temporary files
  976.  ============================================================================
  977. */
  978.  
  979.  if exists(tmpfile1) then do;
  980.   address command mydelete" "tmpfile1
  981.   if rc > 0 then do;
  982.    say "*** Fatal error occured - could not delete "tmpfile1" !"
  983.    call dolog("| ");
  984.    call dolog("* ***Fatal error occured - could not delete "tmpfile1" !");
  985.   end;
  986.  end;
  987.  
  988. return;
  989.